home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / inc / typefile.inc < prev    next >
Text File  |  1998-10-28  |  3KB  |  98 lines
  1. {
  2.     $Id: typefile.inc,v 1.4 1998/07/02 12:16:28 carl Exp $
  3.     This file is part of the Free Pascal Run time library.
  4.     Copyright (c) 1993,97 by the Free Pascal development team
  5.  
  6.     See the File COPYING.FPC, included in this distribution,
  7.     for details about the copyright.
  8.  
  9.     This program is distributed in the hope that it will be useful,
  10.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  11.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12.  
  13.  **********************************************************************}
  14.  
  15. {****************************************************************************
  16.                     subroutines for typed file handling
  17. ****************************************************************************}
  18.  
  19. Procedure assign(var f:TypedFile;const Name:string);
  20. {
  21.   Assign Name to file f so it can be used with the file routines
  22. }
  23. Begin
  24.   FillChar(f,SizeOF(FileRec),0);
  25.   FileRec(f).Handle:=UnusedHandle;
  26.   FileRec(f).mode:=fmClosed;
  27.   Move(Name[1],FileRec(f).Name,Length(Name));
  28. End;
  29.  
  30.  
  31. Procedure assign(var f:TypedFile;p:pchar);
  32. {
  33.   Assign Name to file f so it can be used with the file routines
  34. }
  35. begin
  36.   Assign(f,StrPas(p));
  37. end;
  38.  
  39.  
  40. Procedure assign(var f:TypedFile;c:char);
  41. {
  42.   Assign Name to file f so it can be used with the file routines
  43. }
  44. begin
  45.   Assign(f,string(c));
  46. end;
  47.  
  48.  
  49. Procedure Int_Typed_Reset(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias: 'RESET_TYPED'];
  50. Begin
  51.   If InOutRes <> 0 then exit;
  52.   Reset(UnTypedFile(f),Size);
  53. End;
  54.  
  55.  
  56. Procedure Int_Typed_Rewrite(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias: 'REWRITE_TYPED'];
  57. Begin
  58.   If InOutRes <> 0 then exit;
  59.   Rewrite(UnTypedFile(f),Size);
  60. End;
  61.  
  62.  
  63. Procedure Int_Typed_Write(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias : 'TYPED_WRITE'];
  64. Begin
  65.   If InOutRes <> 0 then exit;
  66.   Do_Write(FileRec(f).Handle,Longint(@Buf),TypeSize);
  67. End;
  68.  
  69.  
  70. Procedure Int_Typed_Read(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias : 'TYPED_READ'];
  71. var
  72.   Result : Longint;
  73. Begin
  74.   If InOutRes <> 0 then exit;
  75.   Result:=Do_Read(FileRec(f).Handle,Longint(@Buf),TypeSize);
  76.   If Result<TypeSize Then
  77.    InOutRes:=100;
  78. End;
  79.  
  80. {
  81.   $Log: typefile.inc,v $
  82.   Revision 1.4  1998/07/02 12:16:28  carl
  83.     * IoCheck routines now check for InOutRes before executing, just like TP
  84.  
  85.   Revision 1.3  1998/05/21 19:31:02  peter
  86.     * objects compiles for linux
  87.     + assign(pchar), assign(char), rename(pchar), rename(char)
  88.     * fixed read_text_as_array
  89.     + read_text_as_pchar which was not yet in the rtl
  90.  
  91.   Revision 1.2  1998/05/12 10:42:45  peter
  92.     * moved getopts to inc/, all supported OS's need argc,argv exported
  93.     + strpas, strlen are now exported in the systemunit
  94.     * removed logs
  95.     * removed $ifdef ver_above
  96.  
  97. }
  98.